home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / bix03.arc / DIR.PAS < prev    next >
Pascal/Delphi Source File  |  1986-08-04  |  2KB  |  117 lines
  1. PROGRAM Testofdir;
  2. TYPE Str=STRING[12];
  3.      Arr=ARRAY[1..64] OF Str;
  4.  
  5. VAR Arry:Arr;
  6.     J:INTEGER;
  7.  
  8. (************************************************************************)
  9.  
  10. PROCEDURE Qsort(VAR LN:Arr;N:INTEGER);
  11. VAR Stack:ARRAY[1..20] OF INTEGER;
  12.     L,I,J,R,S:INTEGER;
  13.     X:Str;
  14.  
  15. (************************************************************************)
  16.  
  17.  PROCEDURE Swap(VAR X,I:Str);
  18.  VAR T:Str;
  19.  BEGIN
  20.   T:=X;
  21.   X:=I;
  22.   I:=T;
  23.  END;
  24.  
  25. BEGIN
  26. S:=1;Stack[S]:=1;Stack[S+1]:=N;
  27. WHILE S>0 DO
  28.  BEGIN
  29.  L:=Stack[S];R:=Stack[S+1];S:=S-2;
  30.   WHILE L<R DO
  31.    BEGIN
  32.      I:=L; J:=R; X:=LN[(L+R) DIV 2];
  33.       WHILE I<=J DO
  34.       BEGIN
  35.       WHILE LN[I]<X DO I:=I+1;
  36.       WHILE X<LN[J] DO J:=J-1;
  37.       IF I<=J THEN
  38.         BEGIN
  39.          Swap(LN[I],LN[J]);
  40.          I:=I+1;
  41.          J:=J-1;
  42.         END;
  43.       END;
  44.       IF I<R THEN
  45.         BEGIN
  46.          S:=S+2;
  47.          Stack[S]:=I;
  48.          Stack[S+1]:=R;
  49.         END;
  50.       R:=J;
  51.    END;
  52.  END;
  53. END;
  54.  
  55. (************************************************************************)
  56.  
  57. PROCEDURE Dir(VAR Arry:Arr; VAR J:INTEGER; Disk:INTEGER);
  58.  
  59. CONST Setdma       =26;
  60.       Search_First =17;
  61.       Search_Next  =18;
  62.  
  63. VAR Buffer : ARRAY [0..127] OF BYTE;
  64.     Fcbuff : ARRAY [0..32] OF BYTE;
  65.     Name   : Str;
  66.     A      : BYTE;
  67.     I      : INTEGER;
  68.  
  69. BEGIN
  70. Name:=''; J:=0;
  71. Bdos(Setdma,ADDR(Buffer));
  72. Fcbuff[0]:=Disk;
  73. FOR I:=1 TO 11 DO Fcbuff[I]:=ORD('?');
  74. FOR I:=12 TO 32 DO Fcbuff[I]:=0;
  75. A:=Bdos(Search_First,ADDR(Fcbuff));
  76. WHILE A<>$Ff DO
  77.  BEGIN
  78.   A:=A * 32;
  79.   FOR I:=A+1 TO A+11 DO
  80.     Name:=Name+CHR(Buffer[I]);
  81.   J:=J+1;
  82.   Arry[J]:=Name;
  83.   Name:='';
  84.   A:=Bdos(Search_Next);
  85.  END;
  86. END;
  87.  
  88. (************************************************************************)
  89.  
  90. PROCEDURE Print(Arry:Arr; J,Col:INTEGER);
  91. VAR I,T,K:INTEGER;
  92. BEGIN
  93. I:=1; T:=J DIV Col;
  94. WHILE I<=J DIV Col DO
  95.  BEGIN
  96.   WRITE('| ');
  97.   FOR K:=0 TO Col-1 DO
  98.    WRITE(Arry[I+K*T],' | ');
  99.   WRITELN;
  100.   I:=I+1;
  101.  END;
  102. IF J MOD Col<>0 THEN WRITE('| ');
  103. FOR K:=0 TO J MOD Col DO
  104.  WRITE(Arry[I+K*T],' | ');
  105. WRITELN;
  106. END;
  107.  
  108. BEGIN
  109. Dir(Arry,J,1);
  110. Qsort(Arry,J);
  111. Print(Arry,J,5);
  112. WRITELN;
  113. Dir(Arry,J,2);
  114. Qsort(Arry,J);
  115. Print(Arry,J,5);
  116. END.
  117.